home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples1.3.Lha / Examples / SimpleTimer / SimpleTimer.bas < prev   
Encoding:
BASIC Source File  |  1994-04-14  |  5.1 KB  |  201 lines
  1. ''
  2. '' $Id: SimpleTimer.bas,v 1.2 1994/03/16 14:53:29 alex Rel $
  3. ''
  4. '' A simple example of using the timer device
  5. ''
  6. '' Derived from RKM example (c) Copyright 1992 Commodore-Amiga, Inc.
  7. ''
  8.  
  9. DEFINT A-Z
  10.  
  11. 'REM $INCLUDE Exec.bh
  12. 'REM $INCLUDE Timer.bc
  13.  
  14. REM $INCLUDE BLib/ExecSupport.bas
  15.  
  16. LIBRARY OPEN "exec.library", LIBRARY_MINIMUM&
  17.  
  18. DIM SHARED junk&
  19.  
  20. ' manifest constants -- "never will change"
  21. CONST SECSPERMIN& = 60
  22. CONST SECSPERHOUR& = 3600    ' 60 * 60
  23. CONST SECSPERDAY& = 86400    ' 60 * 60 * 24
  24.  
  25. SUB delete_timer(BYVAL tr&)
  26.     STATIC tp&
  27.  
  28.     IF tr& <> NULL& THEN
  29.         tp& = PEEKL(tr& + tr_node + IORequestio_Message + mn_ReplyPort)
  30.  
  31.         IF tp& <> 0 THEN DeletePort tp&
  32.  
  33.         CloseDevice tr&
  34.         DeleteExtIO tr&
  35.     END IF
  36. END SUB
  37.  
  38. ' return a pointer to a timer request.  if any problem, return NULL
  39. FUNCTION create_timer&(BYVAL unit&)
  40.     STATIC r&, timerport&, timerIO&
  41.  
  42.     create_timer& = NULL&
  43.     timerport& = CreatePort&(NULL&, 0)
  44.     IF timerport& <> NULL& THEN
  45.         timerIO& = CreateExtIO&(timerport&, timerequest_sizeof)
  46.         IF timerIO& <> NULL& THEN
  47.             r& = OpenDevice&(SADD("timer.device" + CHR$(0)), unit&, timerIO&, 0)
  48.             IF r& = 0 THEN
  49.                 create_timer& = timerIO&
  50.             ELSE
  51.                 delete_timer timerIO&
  52.             END IF
  53.         ELSE
  54.             DeletePort timerport&    ' Delete message port
  55.         END IF
  56.     END IF
  57. END FUNCTION
  58.  
  59. SUB wait_for_timer(BYVAL tr&, BYVAL tv&)
  60.     ' add a new timer request
  61.     POKEW tr& + tr_node + IORequestio_Command, TR_ADDREQUEST&
  62.  
  63.     CopyMem tv&, tr& + tr_time, timeval_sizeof    ' structure assignment
  64.  
  65.     ' post request to the timer -- will go to sleep till done
  66.     junk& = DoIO&(tr&)
  67. END SUB
  68.  
  69. ' more precise timer than AmigaDOS Delay
  70. FUNCTION time_delay(BYVAL tv&, BYVAL unit&)
  71.     STATIC tr&
  72.  
  73.     time_delay = FALSE&
  74.     ' get a pointer to an initialized timer request block
  75.     tr& = create_timer&(unit&)
  76.     IF tr& <> NULL& THEN
  77.         wait_for_timer tr&, tv&
  78.  
  79.         ' deallocate temporary structures
  80.         delete_timer tr&
  81.         time_delay = TRUE&
  82.     END IF
  83. END FUNCTION
  84.  
  85. FUNCTION set_new_time(BYVAL secs&)
  86.     STATIC tr&
  87.  
  88.     set_new_time = FALSE&
  89.     tr& = create_timer&(UNIT_MICROHZ&)
  90.     IF tr& <> NULL& THEN
  91.         POKEL tr& + tr_time + tv_secs, secs&
  92.         POKEL tr& + tr_time + tv_micro, 0&
  93.         POKEW tr& + tr_node + IORequestio_Command, TR_SETSYSTIME&
  94.         junk& = DoIO&(tr&)
  95.  
  96.         delete_timer tr&
  97.         set_new_time = TRUE&
  98.     END IF
  99. END FUNCTION
  100.  
  101. FUNCTION get_sys_time(BYVAL tv&)
  102.     STATIC tr&
  103.  
  104.     get_sys_time = FALSE&
  105.     tr& = create_timer&(UNIT_MICROHZ&)
  106.     IF tr& <> NULL& THEN
  107.         POKEW tr& + tr_node + IORequestio_Command, TR_GETSYSTIME&
  108.         junk& = DoIO&(tr&)
  109.  
  110.         CopyMem tr& + tr_time, tv&, timeval_sizeof    ' structure assignment
  111.  
  112.         delete_timer tr&
  113.         get_sys_time = TRUE&
  114.     END IF
  115. END FUNCTION
  116.  
  117. SUB show_time(BYVAL secs&)
  118.     STATIC days&, hrs&, mins&
  119.  
  120.     ' Compute days, hours, etc.
  121.     mins& = secs& \ 60
  122.     hrs& = mins& \ 60
  123.     days& = hrs& \ 24
  124.     secs& = secs& MOD 60
  125.     mins& = mins& MOD 60
  126.     hrs& = hrs& MOD 24
  127.  
  128.     ' Display the time
  129.     PRINT "*   Hour Minute Second  (Days since Jan.1,1978)"
  130.     PRINT USING "*#####:#####:#####      (######)"; hrs&, mins&, secs&, days&
  131.     PRINT
  132. END SUB
  133.  
  134. SUB main
  135.     STATIC seconds&, junk
  136.     STATIC tr&    ' IO block for timer commands
  137.     DIM oldtimeval(timeval_sizeof \ 2)
  138.     DIM mytimeval(timeval_sizeof \ 2)
  139.     DIM currentval(timeval_sizeof \ 2)
  140.  
  141.     PRINT "Timer test"
  142.  
  143.     ' sleep for two seconds
  144.     POKEL VARPTR(currentval(0)) + tv_secs, 2
  145.     POKEL VARPTR(currentval(0)) + tv_micro, 0
  146.     junk = time_delay(VARPTR(currentval(0)), UNIT_VBLANK&)
  147.     PRINT "After 2 seconds delay"
  148.  
  149.     ' sleep for four seconds
  150.     POKEL VARPTR(currentval(0)) + tv_secs, 4
  151.     POKEL VARPTR(currentval(0)) + tv_micro, 0
  152.     junk = time_delay(VARPTR(currentval(0)), UNIT_VBLANK&)
  153.     PRINT "After 4 seconds delay"
  154.  
  155.     ' sleep for 500,000 micro-seconds = 1/2 second
  156.     POKEL VARPTR(currentval(0)) + tv_secs, 0
  157.     POKEL VARPTR(currentval(0)) + tv_micro, 500000
  158.     junk = time_delay(VARPTR(currentval(0)), UNIT_MICROHZ&)
  159.     PRINT "After 1/2 second delay"
  160.  
  161.     ' save what system thinks is the time....we'll advance it temporarily
  162.     junk = get_sys_time(VARPTR(oldtimeval(0)))
  163.     PRINT "Original system time is:"
  164.     show_time PEEKL(VARPTR(oldtimeval(0)) + tv_secs)
  165.     
  166.     PRINT "Setting a new system time"
  167.  
  168.     seconds& = 1000& * SECSPERDAY& + PEEKL(VARPTR(oldtimeval(0)) + tv_secs)
  169.  
  170.     junk = set_new_time(seconds&)
  171.  
  172.     junk = get_sys_time(VARPTR(mytimeval(0)))
  173.     PRINT "Current system time is:"
  174.     show_time PEEKL(VARPTR(mytimeval(0)) + tv_secs)
  175.  
  176.     ' Added the microseconds part to show that time keeps
  177.     ' increasing even though you ask many times in a row
  178.  
  179.     PRINT "Now do three TR_GETSYSTIMEs in a row (notice how the microseconds increase)"
  180.     PRINT
  181.     junk = get_sys_time(VARPTR(mytimeval(0)))
  182.     PRINT "First TR_GETSYSTIME "; PEEKL(VARPTR(mytimeval(0)) + tv_secs); "."; PEEKL(VARPTR(mytimeval(0)) + tv_micro)
  183.     junk = get_sys_time(VARPTR(mytimeval(0)))
  184.     PRINT "Second TR_GETSYSTIME "; PEEKL(VARPTR(mytimeval(0)) + tv_secs); "."; PEEKL(VARPTR(mytimeval(0)) + tv_micro)
  185.     junk = get_sys_time(VARPTR(mytimeval(0)))
  186.     PRINT "Third TR_GETSYSTIME "; PEEKL(VARPTR(mytimeval(0)) + tv_secs); "."; PEEKL(VARPTR(mytimeval(0)) + tv_micro)
  187.     PRINT
  188.     
  189.     PRINT "Resetting to former time"
  190.     junk = set_new_time(PEEKL(VARPTR(oldtimeval(0)) + tv_secs))
  191.     
  192.     junk = get_sys_time(VARPTR(mytimeval(0)))
  193.     PRINT "Current system time is:"
  194.     show_time PEEKL(VARPTR(mytimeval(0)) + tv_secs)
  195.  
  196.     delete_timer tr&
  197. END SUB
  198.  
  199. main
  200. END
  201.